home *** CD-ROM | disk | FTP | other *** search
/ BBS in a Box 3 / BBS in a box - Trilogy III.iso / Files / Prog / L-M / MacOberon 4.0 / MacOberon™ 4.0 Folder / PopupElems.Mod (.txt) < prev    next >
Encoding:
Oberon Text  |  1993-10-25  |  9.2 KB  |  219 lines  |  [.Ob./.Ob5]
  1. Syntax10.Scn.Fnt
  2. MODULE PopupElems;    (* Michael Franz, 25.10.93 -- "Hypertext without Surprises" *)
  3.     IMPORT
  4.         Oberon, Input, Display, Viewers, Files, Fonts, Printer, Texts, TextFrames, MenuViewers, TextPrinter;
  5.     CONST
  6.         edw=4; edh=2; mdw=3; mdh=1; CR=0DX;    (* margins of element box and menu box *)
  7.     TYPE
  8.         PopupElem=POINTER TO PopupElemDesc;
  9.         PopupElemDesc=RECORD (Texts.ElemDesc)
  10.             name: ARRAY 32 OF CHAR;
  11.             menu: Texts.Text; n, def, wid, lsp, dsc: INTEGER    (* number of items, default, width, line space, descender *)
  12.         END;
  13.         EditFrame=POINTER TO EditFrameDesc;
  14.         EditFrameDesc=RECORD (TextFrames.FrameDesc)
  15.             elem: PopupElem
  16.         END;
  17.         buf: Texts.Buffer;    (* copy buffer *)
  18. (* auxiliary *)
  19.     PROCEDURE Min(x, y: INTEGER): INTEGER;
  20.     BEGIN    IF    x<y    THEN    RETURN x    ELSE    RETURN y    END
  21.     END Min;
  22.     PROCEDURE Max(x, y: INTEGER): INTEGER;
  23.     BEGIN    IF    x>y    THEN    RETURN x    ELSE    RETURN y    END
  24.     END Max;
  25. (* change propagation *)
  26.     PROCEDURE SetupElem(E: PopupElem; fnt: Fonts.Font);
  27.         VAR i, wid, dx, x, y, w, h: INTEGER; p: LONGINT;
  28.     BEGIN    i:=0; wid:=2*edw+4;
  29.         LOOP
  30.             IF    E.name[i]=0X    THEN
  31.                 E.W:=LONG(wid+1)*TextFrames.Unit;
  32.                 E.H:=LONG(fnt.height-fnt.minY+2*edh+2)*TextFrames.Unit;
  33.                 RETURN
  34.             ELSE    Display.GetChar(fnt.raster, E.name[i], dx, x, y, w, h, p); INC(wid, dx); INC(i)    END
  35.         END
  36.     END SetupElem;
  37.     PROCEDURE SetupMenu(E: PopupElem);
  38.         VAR R: Texts.Reader; ch: CHAR; wid, dx, x, y, w, h: INTEGER; p: LONGINT;
  39.     BEGIN    Texts.OpenReader(R, E.menu, 0); E.wid:=0; E.n:=1; E.lsp:=0; wid:=0;
  40.         LOOP    Texts.Read(R, ch);
  41.             IF    R.eot    THEN    E.wid:=Max(E.wid, wid); E.def:=Min(E.def, E.n-1); RETURN
  42.             ELSIF    ch=CR    THEN    E.wid:=Max(E.wid, wid); wid:=0; INC(E.n)
  43.             ELSE    E.lsp:=Max(E.lsp, R.fnt.height); E.dsc:=Min(E.dsc, R.fnt.minY);
  44.                 Display.GetChar(R.fnt.raster, ch, dx, x, y, w, h, p); INC(wid, dx)
  45.             END
  46.         END
  47.     END SetupMenu;
  48. (* interactive editing of popup menus *)
  49.     PROCEDURE* EditHandle(F: Display.Frame; VAR M: Display.FrameMsg);
  50.         VAR F1: EditFrame;
  51.     BEGIN
  52.         WITH    F:EditFrame    DO    TextFrames.Handle(F, M);
  53.             IF    ((M IS Oberon.InputMsg) & (M(Oberon.InputMsg).id=Oberon.consume))
  54.                 OR ((M IS TextFrames.UpdateMsg) & (M(TextFrames.UpdateMsg).text=F.text))
  55.             THEN    SetupMenu(F.elem)
  56.             ELSIF    M IS Oberon.CopyMsg    THEN    NEW(F1);
  57.                 TextFrames.Open(F1, F.text, F.org); F1.elem:=F.elem; M(Oberon.CopyMsg).F:=F1
  58.             END
  59.         END
  60.     END EditHandle;
  61.     PROCEDURE OpenEditor(E: PopupElem);
  62.         VAR V: Viewers.Viewer; F: EditFrame; x, y: INTEGER;
  63.     BEGIN    Oberon.AllocateUserViewer(Oberon.Par.vwr.X, x, y); NEW(F); F.elem:=E;
  64.         TextFrames.Open(F, E.menu, 0); F.handle:=EditHandle;
  65.         V:=MenuViewers.New(TextFrames.NewMenu(E.name, "System.Close "), F, TextFrames.menuH, x, y)
  66.     END OpenEditor;
  67. (* file input/output *)
  68.     PROCEDURE Load(VAR R: Files.Rider; E: PopupElem);
  69.         VAR ch: CHAR; i: INTEGER;
  70.     BEGIN    i:=0;    REPEAT    Files.Read(R, ch); E.name[i]:=ch; INC(i)    UNTIL    ch=0X;
  71.         E.name[i-1]:="."; E.name[i]:="."; E.name[i+1]:="."; E.name[i+2]:=0X; SetupElem(E, Fonts.Default);
  72.         Files.Read(R, ch); E.def:=ORD(ch); E.menu:=TextFrames.Text(""); Texts.Load(R, E.menu)
  73.     END Load;
  74.     PROCEDURE Store(VAR R: Files.Rider; E: PopupElem);
  75.         VAR i: INTEGER;
  76.     BEGIN    i:=0;    WHILE    E.name[i] # 0X    DO    INC(i)    END;
  77.         Files.WriteBytes(R, E.name, i-3); Files.Write(R, 0X);
  78.         Files.Write(R, CHR(E.def MOD 128)); Texts.Store(R, E.menu)
  79.     END Store;
  80. (* graphics *)
  81.     PROCEDURE Box(col, X, Y, W, H: INTEGER);
  82.     BEGIN
  83.         Display.ReplConst(col, X+1, Y+1, W-2, 1, Display.replace);
  84.         Display.ReplConst(col, X+1, Y+H-2, W-2, 1, Display.replace);
  85.         Display.ReplConst(col, X+1, Y+2, 1, H-4, Display.replace);
  86.         Display.ReplConst(col, X+W-2, Y+2, 1, H-4, Display.replace);
  87.         Display.ReplConst(col, X+4, Y, W-4, 1, Display.replace);
  88.         Display.ReplConst(col, X+W-1, Y+1, 1, H-4, Display.replace);
  89.         Display.ReplConst(Display.black, X+2, Y+2, W-4, H-4, Display.replace)
  90.     END Box;
  91.     PROCEDURE PrintElem(E: PopupElem; X, Y: INTEGER; fnt: Fonts.Font);
  92.         VAR W, H: INTEGER;
  93.     BEGIN    W:=SHORT((E.W-1) DIV TextPrinter.Unit); H:=SHORT(E.H DIV TextPrinter.Unit);
  94.         Printer.ReplConst(X, Y, W, 2);
  95.         Printer.ReplConst(X, Y+H-2, W, 2);
  96.         Printer.ReplConst(X, Y+2, 2, H-4);
  97.         Printer.ReplConst(X+W-2, Y+2, 2, H-4);
  98.         Printer.String(X+edw+2, Y+edh+2+fnt.minY, E.name, fnt.name)
  99.     END PrintElem;
  100.     PROCEDURE DrawElem(E: PopupElem; col, X, Y: INTEGER; fnt: Fonts.Font);
  101.         VAR i, dx, x, y, w, h: INTEGER; p: LONGINT;
  102.     BEGIN    Box(col, X, Y, SHORT((E.W-1) DIV TextFrames.Unit), SHORT(E.H DIV TextFrames.Unit));
  103.         INC(X, edw+2); INC(Y, edh+2-fnt.minY); i:=0;
  104.         WHILE    E.name[i] >= " "    DO    Display.GetChar(fnt.raster, E.name[i], dx, x, y, w, h, p);
  105.             Display.CopyPattern(col, p, X+x, Y+y, Display.replace); INC(X, dx); INC(i)
  106.         END
  107.     END DrawElem;
  108.     PROCEDURE DrawMenu(E: PopupElem; X, Y, W, H: INTEGER);
  109.         VAR R: Texts.Reader; ch: CHAR; X0, dx, x, y, w, h: INTEGER; p: LONGINT;
  110.     BEGIN    Box(Display.white, X, Y, W, H);
  111.         Texts.OpenReader(R, E.menu, 0); X0:=X+mdw+2; X:=X0; Y:=Y+H-E.lsp-E.dsc-mdh-2;
  112.         LOOP    Texts.Read(R, ch);
  113.             IF    R.eot    THEN    RETURN
  114.             ELSIF    ch=CR    THEN    Y:=Y-E.lsp; X:=X0
  115.             ELSE    Display.GetChar (R.fnt.raster, ch, dx, x, y, w, h, p);
  116.                 Display.CopyPattern(Display.white, p, X+x, Y+y, Display.replace); INC(X, dx)
  117.             END
  118.         END
  119.     END DrawMenu;
  120. (* actions *)
  121.     PROCEDURE Show(E: PopupElem; X, Y, W, H: INTEGER; VAR cmd: INTEGER);
  122.         VAR mx, my, top, bot, left, right, newCmd: INTEGER; keys: SET;
  123.     BEGIN    left:=X+3; right:=X+W-3; bot:=Y+mdh+3; top:=Y+H-mdh-2;
  124.         Oberon.RemoveMarks(X, Y, W, H); Oberon.FadeCursor(Oberon.Mouse);
  125.         Display.CopyBlock(X, Y, W, H, X, -H, Display.replace); DrawMenu(E, X, Y, W, H);
  126.         Display.ReplConst(Display.white, X+3, top-cmd*E.lsp-E.lsp, W-6, E.lsp, Display.invert);
  127.         REPEAT    Input.Mouse(keys, mx, my);
  128.             Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, mx, my);
  129.             IF    keys*{0,2} # {}    THEN    Oberon.FadeCursor(Oberon.Mouse);
  130.             Display.CopyBlock(X, -H, W, H, X, Y, Display.replace);
  131.                 IF    0 IN keys    THEN    OpenEditor(E)    END;
  132.                 REPEAT    Input.Mouse(keys, mx, my);
  133.                     Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, mx, my)
  134.                 UNTIL keys={};
  135.                 cmd:=-1; RETURN
  136.             ELSIF    (mx>=left) & (mx<=right) & (my>=bot) & (my<=top)    THEN    newCmd:=(top-my) DIV E.lsp;
  137.                 IF    newCmd # cmd    THEN
  138.                     IF    cmd # -1    THEN
  139.                         Display.ReplConst(Display.white, X+3, top-cmd*E.lsp-E.lsp, W-6, E.lsp, Display.invert)
  140.                     END;
  141.                     Display.ReplConst(Display.white, X+3, top-newCmd*E.lsp-E.lsp, W-6, E.lsp, Display.invert);
  142.                     cmd:=newCmd
  143.                 END
  144.             ELSIF    cmd # -1    THEN
  145.                 Display.ReplConst(Display.white, X+3, top-cmd*E.lsp-E.lsp, W-6, E.lsp, Display.invert); cmd:=-1
  146.             END
  147.         UNTIL    keys={};
  148.         Oberon.FadeCursor(Oberon.Mouse); Display.CopyBlock(X, -H, W, H, X, Y, Display.replace);
  149.     END Show;
  150.     PROCEDURE Popup(E: PopupElem; X, Y: INTEGER; F: Display.Frame);
  151.         VAR W, H, mx, my, j, cmd: INTEGER; r: Texts.Reader; ch: CHAR; keys: SET; i, res: INTEGER; cmdStr: ARRAY 32 OF CHAR;
  152.     BEGIN    Input.Mouse(keys, mx, my); W:=E.wid+2*mdw+4; H:=E.n*E.lsp+2*mdh+4;
  153.         Y:=Max(my-H+E.lsp+E.def*E.lsp, 0); cmd:=E.def;
  154.         IF    X+W > Display.Width    THEN    X:=Display.Width-W    END;
  155.         IF    Y+H > Display.Height    THEN    Y:=Display.Height-H    END;
  156.         Show(E, X, Y, W, H, cmd);
  157.         IF    cmd > -1    THEN    E.def:=cmd; j:=0; Texts.OpenReader(r, E.menu, 0); Texts.Read(r, ch);
  158.             WHILE    j < cmd    DO
  159.                 IF    ch=CR     THEN    INC(j)    END;
  160.                 Texts.Read(r, ch)
  161.             END;
  162.             i:=0;
  163.             WHILE    (ch>" ") & (i<31)    DO    cmdStr[i]:=ch; INC(i); Texts.Read(r, ch)    END;
  164.             cmdStr[i]:=0X;
  165.             Oberon.Par.frame:=F; Oberon.Par.text:=E.menu; Oberon.Par.pos:=Texts.Pos(r)-1;
  166.             Oberon.Call(cmdStr, Oberon.Par, FALSE, res)
  167.         END
  168.     END Popup;
  169. (* element *)
  170.     PROCEDURE* Handle(E: Texts.Elem; VAR msg: Texts.ElemMsg);
  171.         VAR e: PopupElem;
  172.     BEGIN
  173.         WITH    E:PopupElem    DO
  174.             IF    msg IS TextFrames.DisplayMsg    THEN
  175.                 WITH    msg:TextFrames.DisplayMsg    DO
  176.                     IF    msg.prepare    THEN    SetupElem(E, msg.fnt)
  177.                     ELSE    DrawElem(E, msg.col, msg.X0, msg.Y0, msg.fnt)    END
  178.                 END
  179.             ELSIF    msg IS TextPrinter.PrintMsg    THEN
  180.                 WITH    msg:TextPrinter.PrintMsg    DO
  181.                     IF    ~msg.prepare    THEN    PrintElem(E, msg.X0, msg.Y0, msg.fnt)    END
  182.                 END
  183.             ELSIF    msg IS Texts.CopyMsg    THEN
  184.                 WITH    msg:Texts.CopyMsg    DO
  185.                     NEW(e); Texts.CopyElem(E, e); e.name:=E.name; e.def:=E.def; e.wid:=E.wid; e.lsp:=E.lsp; e.dsc:=E.dsc; e.n:=E.n;
  186.                     e.menu:=TextFrames.Text(""); Texts.Save(E.menu, 0, E.menu.len, buf); Texts.Append(e.menu, buf); msg.e:=e
  187.                 END
  188.             ELSIF    msg IS Texts.IdentifyMsg    THEN
  189.                 WITH    msg:Texts.IdentifyMsg    DO
  190.                     msg.mod:="PopupElems"; msg.proc:="Alloc"
  191.                 END
  192.             ELSIF    msg IS Texts.FileMsg    THEN
  193.                 WITH    msg:Texts.FileMsg    DO
  194.                     IF    msg.id=Texts.load    THEN    Load(msg.r, E); SetupMenu(E)
  195.                     ELSIF    msg.id=Texts.store    THEN    Store(msg.r, E)    END
  196.                 END
  197.             ELSIF    msg IS TextFrames.TrackMsg    THEN
  198.                 WITH    msg:TextFrames.TrackMsg    DO
  199.                     IF    msg.keys={1}    THEN    Popup(E, msg.X0, msg.Y0, msg.frame)    END
  200.                 END
  201.             END
  202.         END
  203.     END Handle;
  204.     PROCEDURE Alloc*;
  205.         VAR E: PopupElem;
  206.     BEGIN    NEW(E); E.handle:=Handle; Texts.new:=E
  207.     END Alloc;
  208.     PROCEDURE Insert*;
  209.         VAR E: PopupElem; S: Texts.Scanner; i: INTEGER; msg: TextFrames.InsertElemMsg;
  210.     BEGIN    NEW(E); Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
  211.         IF    S.class # Texts.String    THEN    S.s:="Popup"    END;
  212.         i:=0;    REPEAT    E.name[i]:=S.s[i]; INC(i)    UNTIL    S.s[i]=0X;
  213.         E.name[i]:="."; E.name[i+1]:="."; E.name[i+2]:="."; E.name[i+3]:=0X; SetupElem(E, Fonts.Default);
  214.         E.menu:=TextFrames.Text(""); SetupMenu(E); E.handle:=Handle;
  215.         msg.e:=E; Oberon.FocusViewer.handle(Oberon.FocusViewer, msg)
  216.     END Insert;
  217. BEGIN    NEW(buf); Texts.OpenBuf(buf)
  218. END PopupElems.
  219.